home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / ITAB.ICN < prev    next >
Text File  |  1992-09-28  |  3KB  |  101 lines
  1. ############################################################################
  2. #
  3. #    File:     itab.icn
  4. #
  5. #    Subject:  Program to entab an Icon program
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     August 30, 1990
  10. #
  11. ###########################################################################
  12. #
  13. #  itab -- Entab an Icon program, leaving quoted strings alone.
  14. #
  15. #    itab [options] [source-program...]
  16. #
  17. #    options:
  18. #        -i    Input tab spacing (default 8)
  19. #        -o    Outut tab spacing (default 8)
  20. #
  21. #  Observes Icon Programming Language conventions for escapes and
  22. #  continuations in string constants.  If no source-program names are
  23. #  given, standard input is "itabbed" to standard output.
  24. #
  25. ############################################################################
  26. #
  27. #  Links: options, fcopy
  28. #
  29. ############################################################################
  30.  
  31. link options, fcopy
  32.  
  33. global mapchars,intabs,outtabs
  34.  
  35. procedure main(arg)
  36.  
  37.    local opt, fn, f, outfn, outf, f1, f2, buf
  38.  
  39.    opt := options(arg,"i+o+")
  40.    intabs := (\opt["i"] | 8) + 1
  41.    outtabs := (\opt["o"] | 8) + 1
  42.    if *arg = 0 then itab(&input,&output)
  43.    else every fn := !arg do {
  44.       if not (fn[-4:0] == ".icn") then fn ||:= ".icn"
  45.       write(&errout,"Entabbing ",fn)
  46.       f := open(fn) | stop("Can't open input file ",fn)
  47.       outfn := fn || ".temp"
  48.       outf := open(outfn,"w") | stop("Can't open output file ",outfn)
  49.       itab(f,outf)
  50.       close(outf)
  51.       close(f)
  52.       fcopy(outfn,fn)
  53.       remove(outfn)
  54.       }
  55. end
  56.  
  57.  
  58. procedure itab(f,outf)
  59.    local line,c,nonwhite,comment,delim
  60.    line := ""
  61.    while c := readx(f) do {
  62.       if not any(' \t',c) then nonwhite := 1
  63.       case c of {
  64.      "\n": {
  65.         write(outf,map(entab(line,outtabs),\mapchars," \t") | line)
  66.         line := ""
  67.         nonwhite := comment := &null
  68.         }
  69.      "'" | "\"": {
  70.         if /comment then
  71.           (/delim := c) | (if c == delim then delim := &null)
  72.         line ||:= c
  73.         }
  74.      "\\": line ||:= c || if /comment then readx(f) else ""
  75.      "#": {
  76.         if /delim then comment := c
  77.         line ||:= c
  78.         }
  79.      default: {
  80.         line ||:= if /comment & \delim & \nonwhite & \mapchars then
  81.           map(c," \t",mapchars) else c
  82.         }
  83.      }
  84.       }
  85.    return
  86. end
  87.  
  88.  
  89. procedure readx(f)
  90.    static buf,printchars
  91.    initial {
  92.       buf := ""
  93.       printchars := &cset[33:128]
  94.       }
  95.    if *buf = 0 then {
  96.       buf := detab(read(f),intabs) || "\n" | fail
  97.       mapchars := (printchars -- buf)[1+:2] | &null
  98.       }
  99.    return 1(.buf[1],buf[1] := "")
  100. end
  101.